home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 27 / CU Amiga Magazine's Super CD-ROM 27 (1998)(EMAP Images)(GB)[!][issue 1998-10].iso / CUCD / Programming / JForth / Extras / SysGen / STRING-INTERPRET < prev    next >
Encoding:
Text File  |  1991-08-18  |  1.7 KB  |  44 lines
  1. \ execute a string in  addr cnt  form ... Mike Haas, Delta Research
  2.  
  3. \ 00001 18-aug-91  mdh     Incorporated XBLK
  4.  
  5. : $INTERPRET  ( string-addr string-cnt -- ???? )  dup 1024 <
  6.   IF
  7.      PUSHTIB
  8.      XBLK @ >r ( 00001 )  BLK @ >r cprevstart @ >r  lastscan @ >r
  9.      2dup tib swap move      #TIB !  drop  ( -- )
  10.      >in off   fblk off   blk off   xblk off ( 00001 )
  11.      (interpret)
  12.      r> lastscan !   r> cprevstart !  r> blk !  r> xblk ! ( 00001 )
  13.      PULLTIB
  14.   ELSE
  15.      >newline ." Maximum $INTERPRET string size = 1024 character!"  quit
  16.   THEN
  17. ;
  18.  
  19. \ : $INTERPRET  ( string-addr string-cnt -- ???? )
  20. \   'TIB @ >r     #TIB @ >r     >IN @ >r   FBLK @ >r   BLK @ >r
  21. \   #TIB !  'TIB !  >in off   fblk off   blk off
  22. \   cprevstart @ >r  clinestart @ >r  clinenum @ >r  lastscan @ >r
  23. \   (interpret)
  24. \   r> lastscan !  r> cprevstart !
  25. \   r> blk !   r> 'tib !
  26. \ ;
  27.  
  28. \ : $INTERPRET  ( string-addr string-cnt -- ???? )
  29. \   'TIB @ >r     #TIB @ >r     >IN @ >r   FBLK @ >r   BLK @ >r
  30. \   #TIB !  'TIB !  >in off   fblk off   blk off
  31. \   BEGIN   bl word   dup c@  \ is there anything in the input stream left?
  32. \   WHILE   find              \ YES ... is it in the dictionary?
  33. \           IF   compiling?  over >name immediate? 0= and
  34. \                IF   cfa,    \ COMPILE it if in comp mode AND its not immediate
  35. \                ELSE execute \ otherwise, EXECUTE the thing!
  36. \                THEN
  37. \           ELSE  \ if its not found in dictionary, is it a number?
  38. \                 number?
  39. \                 0= 0 ?error  drop [compile] literal
  40. \           THEN
  41. \   REPEAT  \ while we did find find something, go back and check again...
  42. \   drop    \ nothing left to EXECUTE, get rid of address on stack
  43. \   r> blk !   r> fblk !   r> >in !   r> #tib !   r> 'tib !   ;
  44.